In this assignment/tutorial I will demonstrate how to plot networks with the igraph package. During the workgroup I will explain all code. For those of you who don’t attend the workgroups, google knows way more than I do.
Someone who also knows more than I do, especially with respect to plotting of Social Networks is Katya Ognyanova (aka Kateto). Please visit her site.
{{% alert warning %}} In the upper left and right corner of the code blocks you will find copy-to-clipboard buttons. Use these buttons to copy the code to your own editor. {{% /alert %}}
Before you start, check whether you run the latest RStudio version (from the Help menu, pick ‘check for updates’ and whether you need to update R.
install.packages("installr") #you first install packages
require(installr) #then you will need to activate packages.
updateR() #run the function to start the update processGive your script a nice name. Include the author, and data when you last modified the script. Include a lot of comments in your script! Don’t forget, always start with cleaning up your workspace.
And set your working directory.
# set working directory
setwd("C:\\YOURDIR\\YOURSUBDIR\\YOURSUBSUBDIR\\") #change to your own workdirectoryInstall the packages you will need.
We are going to play with Twitter Networks among Dutch MPs.
Download twitter_20190919.RdataLoad the Robject and have a look at it. Save the list elements in separate objects.
load("static/twitter_20190919.RData") #change to your working directory
str(twitter_20190919, 1)
keyf <- twitter_20190919[[1]]
mydata <- twitter_20190919[[2]]
seats <- twitter_20190919[[3]]## List of 3
## $ keyf :'data.frame': 147 obs. of 41 variables:
## $ mydata:List of 8
## ..- attr(*, "higher")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "disjoint")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "atLeastOne")= Named logi [1:9] FALSE FALSE FALSE FALSE FALSE FALSE ...
## .. ..- attr(*, "names")= chr [1:9] "fnet,fnet" "atmnet,fnet" "rtnet,fnet" "fnet,atmnet" ...
## ..- attr(*, "class")= chr "siena"
## $ seats :'data.frame': 150 obs. of 5 variables:So, what do we have?
mydata$depvars). We have three layers:mydata$cCovars){{% alert note %}}
We are going to focus on the atmentions of politicians. This is most closely related to political discussion. Thus who is having discussions with whom on Twitter?
{{% / alert %}}
Let us go fishing for some data:
fnet <- mydata$depvars$fnet
atmnet <- mydata$depvars$atmnet
rtnet <- mydata$depvars$rtnet
vrouw <- mydata$cCovars$vrouw
partij <- mydata$cCovars$partij
ethminz <- mydata$cCovars$ethminz
lft <- mydata$cCovars$lft
# if you construct an object for RSiena, covariates are mean centered by default. I would like to
# have the original values again.
ethminz <- ethminz + attributes(ethminz)$mean
partij <- partij + attributes(partij)$mean
vrouw <- vrouw + attributes(vrouw)$mean
lft <- lft + attributes(lft)$meanHave a look at the network data. What are we a looking at?
## 'sienaDependent' num [1:147, 1:147, 1:3] 0 0 0 1 0 1 0 1 1 1 ...
## - attr(*, "type")= chr "oneMode"
## - attr(*, "sparse")= logi FALSE
## - attr(*, "nodeSet")= chr "Actors"
## - attr(*, "netdims")= int [1:3] 147 147 3
## - attr(*, "allowOnly")= logi TRUE
## - attr(*, "uponly")= logi [1:2] TRUE FALSE
## - attr(*, "downonly")= logi [1:2] FALSE FALSE
## - attr(*, "distance")= int [1:2] 527 277
## - attr(*, "vals")=List of 3
## ..$ : 'table' int [1:4(1d)] 15781 5389 292 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:4] "0" "1" "10" NA
## ..$ : 'table' int [1:4(1d)] 15254 5916 292 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:4] "0" "1" "10" NA
## ..$ : 'table' int [1:3(1d)] 15457 6005 147
## .. ..- attr(*, "dimnames")=List of 1
## .. .. ..$ mymat: chr [1:3] "0" "1" NA
## - attr(*, "nval")= int [1:3] 21462 21462 21462
## - attr(*, "noMissing")= num [1:3] 0 0 0
## - attr(*, "noMissingEither")= num [1:2] 0 0
## - attr(*, "nonMissingEither")= num [1:2] 21462 21462
## - attr(*, "balmean")= num 0.347
## - attr(*, "structmean")= num 0.321
## - attr(*, "simMean")= logi NA
## - attr(*, "symmetric")= logi FALSE
## - attr(*, "missing")= logi FALSE
## - attr(*, "structural")= logi TRUE
## - attr(*, "range2")= num [1:2] 0 1
## - attr(*, "ones")= Named int [1:3] 5389 5916 6005
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "density")= Named num [1:3] 0.251 0.276 0.28
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "degree")= Named num [1:3] 36.7 40.2 40.9
## ..- attr(*, "names")= chr [1:3] "1" "1" "1"
## - attr(*, "averageOutDegree")= num 39.3
## - attr(*, "averageInDegree")= num 39.3
## - attr(*, "maxObsOutDegree")= num [1:3] 137 137 137
## - attr(*, "missings")= num [1:3] 0 0 0
## - attr(*, "name")= chr "fnet"# It is just a 'sienaDependent' something [1:147,1:147,1:3]
fnet1 <- fnet[, , 1]
atmnet1 <- atmnet[, , 1]
atmnet2 <- atmnet[, , 2]
atmnet3 <- atmnet[, , 3]It is just a ‘sienaDependent’ something [1:147,1:147,1:3] but with a lot of attributes which we may ignore for now. It is an array. In this array our nominations are stored in adjacency matrices. I selected the friendship relations and the atmention relations of the first wave.
{{% alert note %}} You may wonder why we only have 147 nodes (of MPs) in our data. Well that is because at the time of writing three MPs did not have a twitter account or at least we could not find it. {{% /alert %}}
One final thing before we can go and play with the data. We have to replace the missing values of RSiena 10 (structural zeros) into 0 (or NA) as well.
The first step is to make a ‘graph object’.
library(igraph)
G1 <- igraph::graph_from_adjacency_matrix(atmnet1, mode = "directed", weighted = NULL, diag = TRUE, add.colnames = NA,
add.rownames = NA)Suppose you would like to add the data to this graph.
require(igraph)
# we need to retrieve the edges.
edges <- as_data_frame(G1, what = "edges")
# the first variable of the data we can attach needs to be some id, thus reorder columns of keyf
keyf <- cbind(keyf$EGOid, keyf[, names(keyf) != "EGOid"])
# the name has been changed as well. Lets correct this
names(keyf)[1] <- "EGOid"
# rebuild the graph.
G1 <- graph_from_data_frame(edges, directed = TRUE, vertices = keyf)
# I am a bit puzzled where the data is stored exactly but the same data as in keyf is now attached to
# the vertices.
# thus to find the names of our MPs we could now do this:
V(G1)$Naam## [1] "Agema, Fleur " "Amhaouch, Mustafa "
## [3] "Arib, Khadija " "v. Ark, Tamara "
## [5] "Azmani, Malik " "Beertema, Harm "
## [7] "Belhaj, Salima " "Bergkamp, Vera "
## [9] "Bisschop, Roelof " "Bosma, Martin "
## [11] "Bosman, Andre " "ten Broeke, Han "
## [13] "Bruins Slot, Hanke " "Van Dijk, Jasper "
## [15] "Dijkgraaf, Elbert " "Dijkstra, Pia "
## [17] "Dijkstra, Remco " "Dik-Faber, Carla "
## [19] "Duisenberg, Pieter " "Geurts, Jaco "
## [21] "De Graaf, Machiel " "Grashoff, Rik "
## [23] "Graus, Dion " "Van Haersma Buma, Sybrand "
## [25] "Harbers, Mark " "Heerma, Pieter "
## [27] "Helder, Lilian " "Van Helvert, Martijn "
## [29] "Keijzer, Mona " "Klaver, jesse "
## [31] "Knops, Raymond " "Kooiman, Nine "
## [33] "Koolmees, Wouter " "Krol, Henk "
## [35] "Kuiken, Attje " "Kuzu, Tunahan "
## [37] "Leijten, Renske " "Lodders, Helma "
## [39] "Madlener, Barry " "Van Meenen, Paul "
## [41] "Mulder, Agnes " "Nijboer, Henk "
## [43] "Nijkerken-de Haan, Chantal " "Van Nispen, Michiel "
## [45] "Omtzigt, Pieter " "Van Oosten, Foort "
## [47] "Ozturk, Selcuk " "Pechtold, Alexander "
## [49] "Van Raak, Ronald " "Roemer, Emile "
## [51] "Rog, Michel " "Ronnes, Erik "
## [53] "De Roon, Raymond " "Rutte, Arno "
## [55] "Schouten, Carola " "Segers, Gert-Jan "
## [57] "Sjoerdsma, Sjoerd " "Van der Staaij, Kees "
## [59] "Tellegen, Ockje " "Thieme, Marianne "
## [61] "Van Toorenburg, Madeleine " "Van Veldhoven, Stientje "
## [63] "Verhoeven, Kees " "Visser, Barbara "
## [65] "Voordewind, Joel " "Voortman, Linda "
## [67] "De Vries, Aukje " "Wassenberg, Frank "
## [69] "Van Weyenberg, Steven " "Wilders, Geert "
## [71] "Van t'Wout, Bas " "Ziengs, Erik "
## [73] "Zijlstra, Halbe " "Rutte, Mark "
## [75] "Ploumen, Lilianne " "Hennis-Plasschaert, Jeanine "
## [77] "Dijsselbloem, Jeroen " "Asscher, Lodewijk "
## [79] "Dijksma, Sharon " "Dekker, Sander "
## [81] "Dijkhoff, Klaas " "Thierry Baudet "
## [83] "Eppo Bruins " "LILIAN MARIJNISSEN "
## [85] "SADET KARABULUT " "SANDRA BECKERMAN "
## [87] "PETER KWINT " "BART VAN KENT "
## [89] "CEM LACIN " "FRANK FUTSELAAR "
## [91] "MAARTEN HIJINK " "Ingrid van Engelshoven "
## [93] "Jan Paternotte " "Rob Jetten "
## [95] "Jessica van Eijs " "Maarten Groothuizen "
## [97] "Rens Raemakers " "Achraf Bouali "
## [99] "Antje Diertens " "Tjeerd de Groot "
## [101] "René Peters " "Harry van der Molen "
## [103] "Anne Kuik " "Chris van Dam "
## [105] "Joba van den Berg-Jansen " "Maurits von Martels "
## [107] "Dennis Wiersma " "Bente Becker "
## [109] "Sophie Hermans " "Anne Mulder "
## [111] "Dilan Yesilgöz-Zegerius " "Daniel Koerhuis "
## [113] "Zohair el Yassini " "Martin Wörsdörfer "
## [115] "Arne Weverling " "Sven Koopmans "
## [117] "Jan Middendorp " "Léonie Sazias "
## [119] "Martin van Rooijen " "Corrie van Brenk "
## [121] "Esther Ouwehand " "Kathalijne Buitenweg "
## [123] "Tom van der Lee " "Corinne Ellemeet "
## [125] "Zihni Özdil " "Bart Snels "
## [127] "Suzanne Kröger " "Bram van Oijk "
## [129] "Nevin Özütok " "Lisa Westerveld "
## [131] "Isabelle Diks " "Liesbeth van Tongeren "
## [133] "Lammert van Raan " "Femke Merel Arissen "
## [135] "Farid Azarkan " "Gijs van Dijk "
## [137] "Kirsten van den Hul " "Gerbrands, Karen "
## [139] "Theo Hiddema " "Vicky Maeijer "
## [141] "Gidi Markuszower " "Danai van Weerdenburg "
## [143] "Edgar Mulder " "Léon de Jong "
## [145] "Gabriëlle Popken " "Alexander Kops "
## [147] "Roy van Aalst "But now let us start plotting.
I cant see anything!! |:-(
Would simplify help?
Still way too dense. What is the density of the network??
## [1] 0.04845774Actually, not very high at all.
But let us try to plot only the reciprocated ties.
# define undirected network
atmnet1_un <- atmnet1 == 1 & t(atmnet1) == 1
G2 <- graph_from_adjacency_matrix(atmnet1_un, mode = "undirected", weighted = NULL, diag = TRUE, add.colnames = NA,
add.rownames = NA)
# attach data if you want
edges <- as_data_frame(G2, what = "edges")
G2 <- graph_from_data_frame(edges, directed = FALSE, vertices = keyf)
plot(G2)
Mmm, It looks like MPs do like to mention themselves! Let simplify again.
Suppose we want to remove the isolates.
# first make sure we don't end up with MPS who only mention themselves
diag(atmnet1_un) <- 0
# lets find the noisolates
noisolates <- rowSums(atmnet1_un, na.rm = T) > 0
# length(noisolates) sum(noisolates) if you select, select both correct nomination network as ego
# characteristics
atmnet1_un_sel <- atmnet1_un[noisolates, noisolates]
# if you are going to use the dataset keyf to add characteristics to the plot later, make sure to run
# the correct selection as well!!!
keyf_sel <- keyf[noisolates, ]
G2_sel <- graph_from_adjacency_matrix(atmnet1_un_sel, mode = "undirected", weighted = NULL, diag = TRUE,
add.colnames = NA, add.rownames = NA)
G2_sel <- simplify(G2_sel)
plot(G2_sel, mode = "undirected")
The same logic of course applies if you would like to select on node attributes (e.g. gender, party).
# option 1: see above. only select MPs from the liberal party
selection <- keyf$Partij == "VVD"
# build new adjacency matrix
atmnet1_un_sel2 <- atmnet1_un[selection, selection]
# etc.
# option 2. Suppose we have attached our dataset to our graph object. only select MPs from the
# liberal party
selection <- V(G2)$Partij == "VVD"
selection_id <- which(selection) # this gives us a numeric variable
G_sel <- induced_subgraph(G2, v = selection_id)
plot(G_sel)
Okay, lets go back and change some stuff.
# adding legend because I am working in Rmarkdown I need some {}
{
plot.igraph(G2, margin = 0, mode = "udirected")
legend(x = -1, y = -1, c("Female", "Male"), pch = 21, col = "#777777", pt.bg = c("red", "green"),
pt.cex = 2, cex = 0.8, bty = "n", ncol = 1)
}
Lets puts the MPs where they belong.
# lets have a look first
plot(keyf$X, keyf$Y, xlim = c(-18, 18), ylim = c(-18, 18), col = keyf$Partij_col, pch = 16)
In case you wonder. The empty seats are the MPs without a Twitter account.
Lets assign these coordinates to our MPs
# it really depends on your plotting window (size, resolution etc.) to get consistent results you
# need to define this beforehand. won't do that now.
# combine atment nets. and make weighted graph. #replace missing values with 0 not with NA
# fnet1[fnet1==10] <- 0 atmnet1[atmnet1==10] <- 0 #combine the graphs Gtes <-
# igraph::graph_from_adjacency_matrix(atmnet1 + fnet1, mode = 'directed', weighted = TRUE, diag =
# TRUE, add.colnames = NA, add.rownames = NA) #save the weight of the edges edges_data <-
# as_data_frame(Gtes, what='edges') #set width of edge E(Gtes)$width <- edges_data$weight #and plot
# plot(Gtes)
# give nodes coler of their party
V(G2)$color <- keyf$Partij_col
# change node size a bit
V(G2)$size = degree(G2) * 1.05 + 6
# remove the labels
V(G2)$label = ""
# less curvature
E(G2)$curved = 0.1
owncoords <- cbind(keyf$X, keyf$Y)
owncoords <- owncoords/8
owncoords[, 1] <- (owncoords[, 1] - mean(owncoords[, 1]))
owncoords[, 2] <- (owncoords[, 2] - mean(owncoords[, 2]))
plot.igraph(G2, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
We can change the edges based on dyad charactersitics but if we have a weighted adjacency matrix also on the weights of the edges. To demonstrate this I first make a weighted atmention network. I simply sum wheter MPs have mentioned each other in t1, t2 and t3.
# construct adjacency matrix first define the recipricated atmentions in each wave
atmnet1_un <- atmnet1 == 1 & t(atmnet1) == 1
atmnet2_un <- atmnet2 == 1 & t(atmnet2) == 1
atmnet3_un <- atmnet3 == 1 & t(atmnet3) == 1
atmnet_weighted <- atmnet1_un + atmnet2_un + atmnet3_un
# contstruct graph / let us keep the loops
G_w <- igraph::graph_from_adjacency_matrix(atmnet_weighted, mode = "undirected", weighted = TRUE, diag = TRUE,
add.colnames = NA, add.rownames = NA)
# attach data
edges <- as_data_frame(G_w, what = "edges")
# rebuild the graph.
G_w <- graph_from_data_frame(edges, directed = FALSE, vertices = keyf)
# add changes as above
V(G_w)$color <- keyf$Partij_col
V(G_w)$size = degree(G_w) * 1.05 + 6
V(G_w)$label = ""
E(G2)$curved = 0.1
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
# save the weight of the edges
edges_data <- as_data_frame(G_w, what = "edges")
# set width of edge edges_data$weight better yet just in one go
E(G_w)$width <- E(G_w)$weight
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])))
# let us make them the color of the nodes if it is between nodes from same party. let us make them
# red if between parties
edges <- get.adjacency(G_w)
edges_mat <- matrix(as.numeric(edges), nrow = nrow(edges))
# edges_mat
# because we have undirected, we only need the edges once ...I know ...
edges_mat[lower.tri(edges_mat)] <- 0
# table(keyf$Geslacht)
teller <- 1
coloredges <- NA
for (i in 1:nrow(edges)) {
for (j in 1:ncol(edges)) {
if (edges_mat[i, j] == 1) {
if (keyf$Partij_col[i] == keyf$Partij_col[j]) {
coloredges[teller] <- keyf$Partij_col[i]
}
if (keyf$Partij_col[i] != keyf$Partij_col[j]) {
coloredges[teller] <- "black"
}
teller <- teller + 1
}
}
}
E(G_w)$color = coloredges
# prepare a legend
Party_names <- unique(keyf$Partij)
Party_cols <- unique(keyf$Partij_col)
png("MPplot.png", width = 900, height = 900)
{
plot.igraph(G_w, mode = "undirected", layout = owncoords, rescale = F, margin = c(0, 0, 0, 0), xlim = c(min(owncoords[,
1]), max(owncoords[, 1])), ylim = c(min(owncoords[, 2]), max(owncoords[, 2])), main = "Reciprocated @mention relations between Dutch MPs (2017)")
legend("topleft", legend = Party_names, pch = 21, col = "#777777", pt.bg = Party_cols, pt.cex = 2,
cex = 0.8, bty = "n", ncol = 3)
text(-2.2, -1.2, "Note 1: Node size based on degree", adj = 0, cex = 0.8)
text(-2.2, -1.3, "Note 2: Edge colar based on Party of MPs, black if MPs from different party", adj = 0,
cex = 0.8)
}
dev.off()## svg
## 2
I hope you like the plot!